home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl5.005.tar.gz / perl5.005.tar / perl5.005 / vms / ext / Stdio / test.pl < prev   
Text File  |  1998-04-02  |  2KB  |  69 lines
  1. # Tests for VMS::Stdio v2.1
  2. use VMS::Stdio;
  3. import VMS::Stdio qw(&flush &getname &rewind &sync &tmpnam);
  4.  
  5. print "1..19\n";
  6. print +(defined(&getname) ? '' : 'not '), "ok 1\n";
  7.  
  8. $name = "test$$";
  9. $name++ while -e "$name.tmp";
  10. $fh = VMS::Stdio::vmsopen("+>$name",'ctx=rec','shr=put','fop=dlt','dna=.tmp');
  11. print +($fh ? '' : 'not '), "ok 2\n";
  12.  
  13. print +(flush($fh) ? '' : 'not '),"ok 3\n";
  14. print +(sync($fh) ? '' : 'not '),"ok 4\n";
  15.  
  16. $time = (stat("$name.tmp"))[9];
  17. print +($time ? '' : 'not '), "ok 5\n";
  18.  
  19. $fh->autoflush;  # Can we autoload autoflush from IO::File?  Do or die.
  20. print "ok 6\n";
  21.  
  22. print 'not ' unless print $fh scalar(localtime($time)),"\n";
  23. print "ok 7\n";
  24.  
  25. print +(rewind($fh) ? '' : 'not '),"ok 8\n";
  26.  
  27. chop($line = <$fh>);
  28. print +($line eq localtime($time) ? '' : 'not '), "ok 9\n";
  29.  
  30. ($gotname) = (getname($fh) =~/\](.*);/);
  31. print +($gotname eq "\U$name.tmp" ? '' : 'not '), "ok 10\n";
  32.  
  33. $sfh = VMS::Stdio::vmssysopen($name, O_RDONLY, 0,
  34.                               'ctx=rec', 'shr=put', 'dna=.tmp');
  35. print +($sfh ? '' : 'not ($!) '), "ok 11\n";
  36.  
  37. close($fh);
  38. sysread($sfh,$line,24);
  39. print +($line eq localtime($time) ? '' : 'not '), "ok 12\n";
  40.  
  41. undef $sfh;
  42. print +(stat("$name.tmp") ? 'not ' : ''),"ok 13\n";
  43.  
  44. print +(&VMS::Stdio::tmpnam ? '' : 'not '),"ok 14\n";
  45.  
  46. if (open(P, qq[| MCR $^X -e "1 while (<STDIN>);print 'Foo';1 while (<STDIN>); print 'Bar'" >$name.tmp])) {
  47.   print P "Baz\nQuux\n";
  48.   print +(VMS::Stdio::writeof(P) ? '' : 'not '),"ok 15\n";
  49.   print P "Baz\nQuux\n";
  50.   print +(close(P) ? '' : 'not '),"ok 16\n";
  51.   $fh = VMS::Stdio::vmsopen("$name.tmp");
  52.   chomp($line = <$fh>);
  53.   close $fh;
  54.   unlink("$name.tmp");
  55.   print +($line eq 'FooBar' ? '' : 'not '),"ok 17\n";
  56. }
  57. else { print "not ok 15\nnot ok 16\nnot ok 17\n"; }
  58.  
  59. $sfh = VMS::Stdio::vmsopen(">$name.tmp");
  60. $setuperl = "\$ MCR $^X\nBEGIN { \@INC = qw(@INC) };\nuse VMS::Stdio qw(&setdef);";
  61. print $sfh qq[\$ here = F\$Environment("Default")\n];
  62. print $sfh "$setuperl\nsetdef();\n\$ Show Default\n\$ Set Default 'here'\n";
  63. print $sfh "$setuperl\nsetdef('..');\n\$ Show Default\n";
  64. close $sfh;
  65. @defs = map { /(\S+)/ && $1 } `\@$name.tmp`;
  66. unlink("$name.tmp");
  67. print +($defs[0] eq uc($ENV{'SYS$LOGIN'}) ? '' : "not ($defs[0]) "),"ok 18\n";
  68. print +($defs[1] eq VMS::Filespec::rmsexpand('[-]') ? '' : "not ($defs[1]) "),"ok 19\n";
  69.